home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Input 64
/
Input_64_86-05_1986_Verlag_Heinz_Weise_de.d64
/
editor .lsp
< prev
next >
Wrap
Text File
|
2023-02-26
|
4KB
|
126 lines
(nx expr (lambda nil (cond ((atom (
cdr clu))) (t (setq clu (cdr clu)) (
setq cl (car clu))))))
(find expr (lambda (l i x w) (cond ((
atom l) nil) ((member i (car l)) (
list x)) ((setq w (find (car l) i 1))
(cons x w)) (t (find (cdr l) i (add1
x))))))
(fi fexpr (nlambda (i) (mapc (quote g)
(find cl i 1 nil)) (p)))
(b fexpr (nlambda l (rplaca clu (setq
cl (conc l (car clu)))) (back)) value
(a b (c d e) f g))
(: fexpr (nlambda (l) (rplaca clu (
setq cl l))))
(lo expr (lambda (x y z) (setq z (nth
cl (h x))) (setq y (nth cl (h (sub1 x)
))) (cond ((consp (car z)) (rplacd y (
car z))))))
(li expr (lambda (x) (bi x -1)))
(r fexpr (nlambda (x y) (repl x y cl))
)
(repl expr (lambda (x y l) (cond ((
atom l) nil) ((equal (car l) x) (
rplaca l y) (repl x y (cdr l))) ((
equal (cdr l) x) (rplacd l y)) (t (
repl x y (car l)) (repl x y (cdr l))))
))
(ro expr (lambda (x y) (cond ((null y)
(setq y (length cl)))) (setq x (nth
cl (h x))) (setq y (nth cl (h y))) (
rplaca x (conc (car x) (cdr x))) (
rplacd x (cdr y)) (rplacd y nil)))
(bo expr (lambda (x) (setq x (nth cl (
h x))) (setq y (conc (car x) (cdr x)))
(rplaca x (car y)) (rplacd x (cdr y))
))
(bi expr (lambda (x y) (cond ((null y)
(setq y x))) (setq x (nth cl (h x)))
(setq y (nth cl (h y))) (setq z (cdr
y)) (rplacd y nil) (rplaca x (cons (
car x) (cdr x))) (rplacd x z)))
(ri expr (lambda (x y) (setq x (nth
cl (h x))) (setq y (nth (car x) (h y))
) (setq z (cdr x)) (rplacd x (cdr y))
(conc (cdr y) z) (rplacd y nil)))
(expt expr (lambda (x y) (cond ((eq y
0) 1) (t (times x (expt x (sub1 y)))))
))
(e fexpr (nlambda (l) (print (eval l))
) value (nlambda (l) (print (eval l)))
)
(_ expr (lambda nil (setq clu (last
tr)) (setq tr (list clu)) (setq cl (
car clu))))
(n fexpr (nlambda l (conc cl l)))
(a fexpr (nlambda l (rplacd clu (conc
l (cdr clu))) (back)) value (nlambda
l (rplacd clu (conc l (cdr clu))) (
back)))
(conc expr (lambda (l1 l2) (cond ((
atom l1) l2) ((atom l2) l1) (t (nconc
l1 l2)))))
(del expr (lambda (x l) (setq x (h x))
(cond ((atom cl) cl) ((zerop x) (
rplaca clu (setq cl (conc l cl)))) ((
eq x 1) (rplaca clu (setq cl (conc l (
cdr cl))))) (t (rplacd (nth cl (sub1
x)) (conc l (nth cl (add1 x))))))))
(undo expr (lambda nil (setq lis (
copy old)) (setq clu (list lis)) (
setq tr (list clu)) (setq cl (car clu)
)))
(out expr (lambda nil (save 8
"@0:editor.lsp" edfns)))
(add fexpr (nlambda l (cond ((atom l)
edfns) (t (setq edfns (cons (car l)
edfns)) (apply (quote add) (cdr l)))))
)
(p@ expr (lambda nil (pp cl)))
(back expr (lambda nil (cond ((atom (
cdr tr)) cl) (t (setq clu (car tr)) (
setq tr (cdr tr)) (setq cl (car clu)))
)))
(g expr (lambda (x) (setq x (h x)) (
cond ((zerop x) (back)) ((greaterp x (
length cl)) cl) (t (setq tr (cons clu
tr)) (setq clu (nth cl x)) (setq cl (
car clu))))))
(p expr (lambda nil (print (p& cl)))
value (lambda nil (print (p& cl))))
(p& expr (lambda (l) (cond ((atom l)
l) (t (cons (p& (car l)) (mapcar (
quote (lambda (x) (cond ((atom x) x) (
t (quote &))))) (cdr l)))))))
(h expr (lambda (x) (cond ((minusp x)
(setq x (abs (plus 1 x (length cl)))))
) (cond ((greaterp x (length cl)) (
length cl)) (t x))))
(edfns value (nx find fi b : lo li r
repl ro bo bi ri expt e _ n a conc
del undo out add p@ back g p p& h
edfns edit editf editv editp))
(edit expr (lambda (l) (prog (old tr
cl clu e x lis) (setq old l) (setq
lis (copy l)) (setq clu (list lis)) (
setq tr (list clu)) (setq cl (car clu)
) (p) loop1 (msg "*ed*: ") (setq e (
readl)) loop2 (cond ((atom e) (go
loop1))) (setq x (car e)) (cond ((
numberp x) (g x)) ((eq x (quote ok)) (
return (car (last tr)))) ((eq x (
quote pp)) (pp cl)) ((atom x) (eval (
list x))) ((numberp (car x)) (del (
car x) (cdr x))) (t (eval x))) (setq
e (cdr e)) (go loop2))))
(editf fexpr (nlambda (f l) (cond ((
setq l (apply (quote getdef) (list f))
) (eval (cons (car l) (cons (cadr l) (
edit (cddr l)))))))))
(editv fexpr (nlambda (f) (set f (
edit (eval f)))))
(editp fexpr (nlambda (a p) (putprop
a p (edit (getprop a p)))))
nil